home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / keyinp.zip / GS_KEYI.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  10KB  |  361 lines
  1. unit GS_KeyI;
  2.  
  3. {      Written by  Richard F Griffin
  4.  
  5.        1 December 1988, (Released to the public domain)
  6.  
  7.        1110 Magnolia Circle
  8.        Papillion, Nebraska  68128
  9.  
  10.        CIS 75206.231
  11.  
  12.    This unit allows you to set data entry routines quickly and simply.
  13.    It also gives the programmer the capability to override the entry
  14.    routine and use another procedure to handle function keys.
  15.  
  16. }
  17.  
  18.  
  19. interface
  20.  
  21. uses crt, dos;
  22.  
  23. type
  24.    GS_KeyI_str80 = string[80];
  25.  
  26. var
  27.    GS_KeyI_Chr : char;
  28.    GS_KeyI_Fuc,
  29.    GS_KeyI_Esc : boolean;
  30.    GS_KeyI_Hlp : pointer;
  31.    GS_KeyI_Psn : integer;
  32.  
  33. Function GS_KeyI_Get : char;
  34.  
  35. procedure GS_KeyI_Key(wait : boolean;Fldcnt,x,y : integer);
  36.  
  37. function GS_KeyI_T(waitcr: boolean;Fl,X,Y,B:integer;CTitl,
  38.                  CVal:GS_KeyI_str80) : GS_KeyI_str80;
  39.  
  40. function GS_KeyI_I(waitcr:boolean;Fl,x,y,B:integer;
  41.                 CTitl:GS_KeyI_str80;XVal,l,h:integer) : integer;
  42.  
  43. function GS_KeyI_R(waitcr:boolean;Fl,x,y,B:integer;CTitl:GS_KeyI_str80;
  44.                           XVal,l,h:real;d:integer) : real;
  45.  
  46. implementation
  47.  
  48. var
  49.    Big_String : GS_KeyI_str80;
  50.  
  51. {$F+}
  52. procedure GS_KeyI_Dum;
  53. begin
  54.    write(#7);
  55. end;
  56. {$F-}
  57.  
  58. {
  59.    This procedure is an Inline far call.  The address is inserted by
  60.    GS_KeyI_Call based on the address in GS_KeyI_Hlp.  This address is
  61.    initially to GS_KeyI_Dum, but may be changed by the using program.
  62.  
  63.    ex:  GS_KeyI_Hlp := @MyProcedure
  64.  
  65.    The procedure will be called when a special function key (F1, F2,
  66.    Home, RtArrow, etc.) is pressed during data entry.  The using procedure
  67.    may then use GS_KeyI_Chr to find which key was pressed.  It is up to the
  68.    using program to ensure the screen and window sizes are properly restored.
  69.    The programmer must ensure that the $F+ option is used in the procedure
  70.    to force a Far Return.
  71.  
  72.         -----------      DO NOT MODIFY THIS ROUTINE        ------------
  73. }
  74.  
  75. procedure GS_KeyI_Jmp;
  76. begin
  77.    InLine ($9A/$00/$00/$00/$00);       {CALLF [GS_KeyI_Hlp]}
  78. end;
  79.  
  80. {
  81.    Inserts a Far Call address for GS_KeyI_Jmp.
  82.    Works in TP 4 and 5.
  83. }
  84.  
  85. procedure GS_KeyI_Call;
  86. begin
  87.    MemW[seg(GS_KeyI_Jmp):ofs(GS_KeyI_Jmp)+11] := ofs(GS_KeyI_Hlp^);
  88.    MemW[seg(GS_KeyI_Jmp):ofs(GS_KeyI_Jmp)+13] := seg(GS_KeyI_Hlp^);
  89.    GS_KeyI_Jmp;
  90. end;
  91.  
  92. Function GS_KeyI_Get : char;
  93. var ch: char;
  94. begin
  95.   Ch := ReadKey;
  96.   If (Ch = #0) then  { it must be a function key }
  97.   begin
  98.     Ch := ReadKey;
  99.     GS_KeyI_Fuc := true;
  100.   end
  101.   else GS_KeyI_Fuc := false;
  102.   GS_KeyI_Get := Ch;
  103. end;
  104.  
  105. procedure GS_KeyI_Key(wait : boolean;Fldcnt,x,y : integer);
  106. Var
  107.    Big_S : GS_KeyI_str80;
  108.    i : integer;
  109. begin
  110.    Big_s := '';
  111.    GS_KeyI_Psn := 0;
  112.    gotoxy(x,y);
  113.    Repeat
  114.       GS_KeyI_Chr := GS_KeyI_Get;
  115.       GS_KeyI_Esc := false;
  116.       if not GS_KeyI_Fuc then
  117.       begin
  118.          case GS_KeyI_Chr of
  119.             #08        : begin
  120.                             If GS_KeyI_Psn > 0 then
  121.                             begin
  122.                                GS_KeyI_Psn := GS_KeyI_Psn - 1;
  123.                                gotoxy(x+GS_KeyI_Psn,y);
  124.                                write('_');
  125.                                gotoxy(x+GS_KeyI_Psn,y);
  126.                                delete(Big_S,length(Big_S),1);
  127.                             end else
  128.                             begin
  129.                                write('_');
  130.                                gotoxy(x+GS_KeyI_Psn,y);
  131.                             end;
  132.                          end;
  133.             ' '..'}'   : begin
  134.                             if (GS_KeyI_Psn = Fldcnt) and (wait) then
  135.                                 write(#7)
  136.                             else begin
  137.                                if GS_KeyI_Psn = 0 then
  138.                                begin
  139.                                   for i := 1 to Fldcnt do write('_');
  140.                                   gotoxy(x,y);
  141.                                end;
  142.                                GS_KeyI_Psn := GS_KeyI_Psn + 1;
  143.                                write(GS_KeyI_Chr);
  144.                                Big_S := Big_S + GS_KeyI_Chr;
  145.                             end;
  146.                          end;
  147.             #27        : begin
  148.                             Big_S := ' ';
  149.                             GS_KeyI_Esc := true;
  150.                          end;
  151.          end;
  152.       end else
  153.       begin
  154.          GS_KeyI_Call;
  155.          gotoxy(x+GS_KeyI_Psn,y);
  156.       end;
  157.    until (GS_KeyI_Chr in [#13,#27]) or ((GS_KeyI_Psn = Fldcnt) and (not wait));
  158.    Big_String := Big_S;
  159. end;
  160.  
  161. { The GS_KeyI_T function will process an input from the keyboard and display
  162.   it on the screen in a specified location.  The length of the input field is
  163.   given, as well as a default entry.  The default entry is optionally shown
  164.   on the screen.
  165.  
  166.   Parameter descriptions are:
  167.  
  168.         1  Boolean flag to determine whether to wait for a carriage return
  169.            once the field is full.
  170.  
  171.         2  Length of input field.
  172.  
  173.         3  Horizontal location to start.
  174.  
  175.         4  Vertical position to start.
  176.  
  177.         5  Vertical line to place default value.  Should be 0 to inhibit
  178.            display of default.  Will usually be the same as (4).
  179.  
  180.         6  The prompt to place on the screen prior to the data entry field.
  181.            Should be '' if no prompt.
  182.  
  183.         7  Default value.
  184.  
  185. }
  186.  
  187.  
  188. function GS_KeyI_T(waitcr: boolean;Fl,X,Y,B:integer;CTitl,
  189.                    CVal:GS_KeyI_str80) : GS_KeyI_str80;
  190. var
  191.    i : integer;
  192. begin
  193.   GS_KeyI_T := '';
  194.   gotoxy(x,y);
  195.   write(CTitl);
  196.   for i := 1 to Fl do write('_');
  197.   if B <> 0 then
  198.   begin
  199.      gotoxy(x+length(CTitl),B);
  200.      write(CVal);
  201.   end;
  202.   GS_KeyI_Key(waitcr,FL,x+length(CTitl),y);
  203.   if Big_String = '' then Big_String := CVal;
  204.   if GS_KeyI_Esc then Big_String := ' ';
  205.   gotoxy(x+length(CTitl),y);
  206.   write(Big_String,'':Fl-length(Big_String));
  207.   if (B <> 0) and (B <> Y) then
  208.   begin
  209.      gotoxy(x+length(CTitl),B);
  210.      write('':length(CVal));
  211.   end;
  212.   GS_KeyI_T := Big_String;
  213. end;
  214.  
  215. { The GS_KeyI_I function will accept an integer from the keyboard and display
  216.   it on the screen in a specified location.  The length of the input field is
  217.   given, as well as a default entry.  The default entry is optionally shown
  218.   on the screen.  A range of acceptable values is also specified.
  219.  
  220.   Parameter descriptions are:
  221.  
  222.         1  Boolean flag to determine whether to wait for a carriage return
  223.            once the field is full.
  224.  
  225.         2  Length of input field.
  226.  
  227.         3  Horizontal location to start.
  228.  
  229.         4  Vertical position to start.
  230.  
  231.         5  Vertical line to place default value.  Should be 0 to inhibit
  232.            display of default.  Will usually be the same as (4).
  233.  
  234.         6  The prompt to place on the screen prior to the data entry field.
  235.            Should be '' if no prompt.
  236.  
  237.         7  Default value.
  238.  
  239.         8  Lowest value acceptable.
  240.  
  241.         9  Highest value acceptable.
  242.  
  243. }
  244.  
  245.  
  246. function GS_KeyI_I(waitcr:boolean;Fl,x,y,B:integer;
  247.                 CTitl:GS_KeyI_str80;XVal,l,h:integer) : integer;
  248. Var
  249.    Cod, q, i : integer;
  250.    CVal : GS_KeyI_str80;
  251.  
  252. begin
  253.    str(XVal:Fl,CVal);
  254.    Cod := 1;
  255.    while Cod <> 0 do
  256.    begin
  257.       Big_String := GS_KeyI_T(waitcr,Fl,X,Y,B,CTitl,CVal);
  258.       if GS_KeyI_Esc then
  259.       begin
  260.          GS_KeyI_I := XVal;
  261.          Exit;
  262.       end;
  263.       if Big_String[length(Big_String)] = ' ' then
  264.          Big_String := 'z';
  265.       for i := 1 to length(Big_String) do
  266.          if Big_String[i] = ' ' then Big_String[i] := '0';
  267.       val(Big_String,q,Cod);
  268.       if Cod <> 0 then
  269.       begin
  270.          write(chr(7));
  271.       end else
  272.       begin
  273.          if (q < l) or (q > h) then
  274.          begin
  275.             Cod := 1;
  276.             write(chr(7));
  277.          end;
  278.       end;
  279.    end;
  280.    GS_KeyI_I := q;
  281. end;
  282.  
  283.  
  284. { The GS_KeyI_R function will accept a real number from the keyboard and
  285.   display it on the screen in a specified location.  The length of the
  286.   input field is given, as well as a default entry.  The default entry
  287.   is optionally shown on the screen.  A range of acceptable values is
  288.   also specified.
  289.  
  290.   Parameter descriptions are:
  291.  
  292.         1  Boolean flag to determine whether to wait for a carriage return
  293.            once the field is full.
  294.  
  295.         2  Length of input field.
  296.  
  297.         3  Horizontal location to start.
  298.  
  299.         4  Vertical position to start.
  300.  
  301.         5  Vertical line to place default value.  Should be 0 to inhibit
  302.            display of default.  Will usually be the same as (4).
  303.  
  304.         6  The prompt to place on the screen prior to the data entry field.
  305.            Should be '' if no prompt.
  306.  
  307.         7  Default value.
  308.  
  309.         8  Lowest value acceptable.
  310.  
  311.         9  Highest value acceptable.
  312.  
  313.        10  Number of decimal places.
  314.  
  315. }
  316.  
  317.  
  318. function GS_KeyI_R(waitcr:boolean;Fl,x,y,B:integer;CTitl:GS_KeyI_str80;
  319.                           XVal,l,h:real;d:integer) : real;
  320. Var
  321.    Cod, i : integer;
  322.    CVal : GS_KeyI_str80;
  323.    r : real;
  324.  
  325. begin
  326.    str(XVal:Fl:d,CVal);
  327.    Cod := 1;
  328.    while Cod <> 0 do
  329.    begin
  330.       Big_String := GS_KeyI_T(waitcr,Fl,X,Y,B,CTitl,CVal);
  331.       if GS_KeyI_Esc then
  332.       begin
  333.          GS_KeyI_R := XVal;
  334.          Exit;
  335.       end;
  336.       if Big_String[length(Big_String)] = ' ' then
  337.          Big_String := 'z';
  338.       for i := 1 to length(Big_String) do
  339.          if Big_String[i] = ' ' then Big_String[i] := '0';
  340.       val(Big_String,r,Cod);
  341.       if Cod <> 0 then
  342.       begin
  343.          write(chr(7));
  344.       end else
  345.       begin
  346.          if (r < l) or (r > h) then
  347.          begin
  348.             Cod := 1;
  349.             write(chr(7));
  350.          end;
  351.       end;
  352.    end;
  353.    gotoxy(x+length(CTitl),y);
  354.    str(r:Fl:d,Big_String);
  355.    write(Big_String,'':Fl-length(Big_String));
  356.    GS_KeyI_R := r;
  357. end;
  358.  
  359. begin
  360.    GS_KeyI_Hlp := @GS_KeyI_Dum;
  361. end.